home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #11 / Amiga Plus CD - 2004 - No. 11.iso / AmiSoft / Dev / misc / temgen.lha / Temgen / tg-0.11 / eval.c < prev    next >
C/C++ Source or Header  |  2002-12-18  |  22KB  |  899 lines
  1. #include "atom.h"
  2. #include "db.h"
  3. #include "debug.h"
  4. #include "eval.h"
  5. #include "frame.h"
  6. #include "func.h"
  7. #include "generator.h"
  8. #include "istack.h"
  9. #include "omani.h"
  10. #include "strbuf.h"
  11. #include "srctab.h"
  12. #include "sysdefs.h"
  13. #include "stack.h"
  14. #include "util.h"
  15. #include "version.h"
  16.  
  17. static int eval_initialized = 0;
  18.  
  19. /* registers */
  20. static int A_reg = -1;
  21. static int Globals = -1;
  22.  
  23. static struct istack *Stack = 0;   /* function parameter stack   */
  24.  
  25. static int VarStack = -1;          /* temporary objects stack    */ 
  26. static int Const = -1;             /* constructed objects        */
  27. static int NextFreeConst = 0;
  28. static int Frames = -1;            /* frames pool                */
  29.  
  30. static int System = -1;            /* artificial "system" object */
  31.  
  32. static void init_system( void ) 
  33. {
  34.     int fld;
  35.     System = ob_field( Globals, atom("system") );
  36.     fld = ob_field( System, atom("version"));
  37.     ob_set( fld, 's', VERSION );
  38. }
  39.  
  40. int system_obj( void )
  41. {
  42.     if ( System <= 0 ) init_system();
  43.     return System;
  44. }
  45.  
  46. static void init_eval( void )
  47. {
  48.     int root;
  49.     if ( !eval_initialized ) {
  50.         root = ob_root();
  51.         A_reg = ob_item( root, 0 );
  52.         Globals = ob_item( root, 1 );
  53.         Stack = is_init();
  54.         if ( !Stack ) fatal( "memory allocation error" );
  55.         VarStack = ob_item( root, 3 );
  56.         stinit( VarStack );
  57.         Const = ob_item( root, 4 );
  58.         Frames = ob_item( root, 5 );
  59.         NextFreeConst = 0;
  60.         init_system();
  61.         eval_initialized = 1;  
  62.     }
  63. }
  64.  
  65. int tmp_alloc( void )
  66. {
  67.     init_eval();
  68.     return stalloc();
  69. }
  70.  
  71. void tmp_free( int obj )
  72. {
  73.     init_eval();
  74.     stfree( obj );
  75. }
  76.  
  77. int nextreg( void )
  78. {
  79.     return NextFreeConst++;
  80. }
  81.  
  82. static int refer( int obj ) 
  83. {
  84. #define       MAXREFLOOP        512 
  85.      int i;
  86.      
  87.      for ( i=0; i<MAXREFLOOP; i++ ) {
  88.          if ( ob_type(obj) != 'R' ) break;
  89.          obj = ob_geti( obj );
  90.      }
  91.      
  92.      return obj;
  93. }
  94.  
  95. const char *print_obj( int obj )
  96. {
  97.     static char cbuf[ 64 ];
  98.    
  99.     obj = refer( obj );
  100.     
  101.     switch( ob_type(obj) ) {
  102.         case 'i':
  103.             sprintf( cbuf, "%d", ob_geti( obj ));
  104.             return cbuf;
  105.         case 'f':
  106.             sprintf( cbuf, "%f", ob_getf( obj ));
  107.             return cbuf;
  108.         case 's':
  109.             return ob_gets( obj );
  110.     } 
  111.  
  112.     return "";
  113. }
  114.  
  115. static const char *glue( int a, int b )
  116. {
  117.     static struct strbuf *buf = NULL;
  118.     
  119.     if ( !buf ) 
  120.         buf = new_strbuf( 1024, 1024 );
  121.     else
  122.         sb_clear( buf );
  123.  
  124.     sb_cat( buf, print_obj( a ), 0x7ffffff0 );
  125.     sb_cat( buf, print_obj( b ), 0x7ffffff0 );
  126.     
  127.     return sb_data( buf );
  128. }
  129.  
  130. static void eval_arith( int reg, int a, char op, int b )
  131. {
  132.     char atype, btype;
  133.     int i1, i2;
  134.     float f1, f2;
  135.  
  136.     a = refer( a );
  137.     b = refer( b );
  138.     
  139.     atype = ob_type( a );
  140.     if ( atype == '\0' ) {
  141.         ob_set( a, 'i', 0 );
  142.         atype = ob_type( a );
  143.     }
  144.     btype = ob_type( b );
  145.    
  146.     if ( (atype=='s' || btype=='s') && op=='+' ) {
  147.         ob_set( reg, 's', glue( a, b ) );
  148.         return;
  149.     }
  150.     
  151.     switch( atype ) {
  152.         case 'i':
  153.             i1 = ob_geti( a );
  154.             switch( btype ) {
  155.                 case 'i':
  156.                     i2 = ob_geti( b );
  157.                     switch( op ) {
  158.                         case '+':
  159.                             ob_set( reg, 'i', i1 + i2 );
  160.                             break;
  161.                         case '-':
  162.                             ob_set( reg, 'i', i1 - i2 );
  163.                             break;
  164.                         case '*':
  165.                             ob_set( reg, 'i', i1 * i2 );
  166.                             break;
  167.                         case '/':
  168.                             ob_set( reg, 'f', 
  169.                                     (double)(i2 ? ((double)i1 / (double)i2): 0) );
  170.                             break;
  171.                     }
  172.                     break;
  173.                 case 'f':
  174.                     f2 = ob_getf( b );
  175.                     switch( op ) {
  176.                         case '+':
  177.                             ob_set( reg, 'f', i1 + f2 );
  178.                             break;
  179.                         case '-':
  180.                             ob_set( reg, 'f', i1 - f2 );
  181.                             break;
  182.                         case '*':
  183.                             ob_set( reg, 'f', i1 * f2 );
  184.                             break;
  185.                         case '/':
  186.                             ob_set( reg, 'f', f2 ? (i1 / f2): 0 );
  187.                             break;
  188.                     }
  189.                     break;
  190.                 default:
  191.                     ob_set( reg, 's', "" );
  192.             }
  193.             break;
  194.         case 'f':
  195.             f1 = ob_getf( a );
  196.             switch( btype ) {
  197.                 case 'i':
  198.                     i2 = ob_geti( b );
  199.                     switch( op ) {
  200.                         case '+':
  201.                             ob_set( reg, 'f', f1 + i2 );
  202.                             break;
  203.                         case '-':
  204.                             ob_set( reg, 'f', f1 - i2 );
  205.                             break;
  206.                         case '*':
  207.                             ob_set( reg, 'f', f1 * i2 );
  208.                             break;
  209.                         case '/':
  210.                             ob_set( reg, 'f', i2 ? (f1 / i2): 0 );
  211.                             break;
  212.                     }
  213.                     break;
  214.                 case 'f':
  215.                     f2 = ob_getf( b );
  216.                     switch( op ) {
  217.                         case '+':
  218.                             ob_set( reg, 'f', f1 + f2 );
  219.                             break;
  220.                         case '-':
  221.                             ob_set( reg, 'f', f1 - f2 );
  222.                             break;
  223.                         case '*':
  224.                             ob_set( reg, 'f', f1 * f2 );
  225.                             break;
  226.                         case '/':
  227.                             ob_set( reg, 'f', f2 ? (f1 / f2): 0 );
  228.                             break;
  229.                     }
  230.                     break;
  231.                 default:
  232.                     ob_set( reg, 's', "" );
  233.             }
  234.             break;
  235.             
  236.         default:
  237.             ob_set( reg, 's', "" );
  238.     }
  239. }
  240.  
  241. int objtoint( int obj )
  242. {
  243.     obj = refer( obj );
  244.  
  245.     switch( ob_type( obj ) ) {
  246.         case 'i':
  247.             return ob_geti( obj );
  248.         case 'f':
  249.             return (int)ob_getf( obj );
  250.         default:
  251.             return -1;
  252.     }
  253. }
  254.  
  255. static int plist_len( struct param *p )
  256. {
  257.         if ( !p ) return 0;
  258.         return 1 + plist_len( p->h );
  259. }
  260.  
  261. static int elist_len( struct explist *el )
  262. {
  263.         if ( !el ) return 0;
  264.         return 1 + elist_len( el->h );
  265. }
  266.  
  267. static void do_args( int frame, struct param *p, struct explist *el )
  268. {
  269.     int plen, ellen;
  270.  
  271.     
  272.     if ( !( p && el ) ) return; 
  273.  
  274.     plen = plist_len( p );
  275.     ellen = elist_len( el );
  276.    
  277.     if ( plen > ellen ) {
  278.             while( plen > ellen ) {
  279.                     p = p->h;
  280.                     plen--;
  281.             }
  282.     }
  283.     else if ( plen < ellen ) {
  284.             while( plen < ellen ) {
  285.                     el = el->h;
  286.                     plen++;
  287.             }
  288.     }
  289.     
  290.     do_args( frame, p->h, el ? el->h: NULL );
  291.     if ( el && el->t ) {
  292.         eval( ob_field( frame, p->t ), el->t );
  293. #if  0      
  294.         dump_expression( dbuf, sizeof(dbuf), el->t );
  295.         ob_print( dbuf2, sizeof(dbuf2), ob_field( frame, p->t ));
  296.         dbpr( "do_args, SP: %d, %s=%s : %s\n", StackPtr, atom_name(p->t), 
  297.                 dbuf, dbuf2 );
  298. #endif        
  299.     } else
  300.         ob_set( ob_field( frame, p->t ), 's', "" );
  301. }
  302.  
  303. static int makeargs( struct param *p, struct explist *el )
  304. {
  305.     int frame;
  306.     
  307.     frame = frame_alloc( Frames );
  308.     ob_set( frame, 'i', 0 );
  309.     do_args( frame, p, el );
  310.     return frame;
  311. }
  312.  
  313. static void push_args( int frame )
  314. {
  315.     is_push( Stack, frame );
  316. }
  317.  
  318. static void pop_args( int frame )
  319. {
  320.     is_pop( Stack );
  321.     frame_free( Frames, frame );
  322. }
  323.  
  324. static int call( struct funpart f )
  325. {
  326.     int sys=0, frame, maxndx, cur, file, line, res;
  327.     struct sourcefile *sf;
  328.     struct command *fun;
  329.     struct sysfun *sfun;
  330.     
  331.     if ( !f.h ) return -1;
  332.     if ( f.h->type != 'n' ) return -2;
  333.     if ( findfun( f.h->val.name, &file, &line )) {
  334.         if ( (sfun = findsys( f.h->val.name )) == NULL ) 
  335.             return -3;
  336.         else
  337.             sys = 1;
  338.     }
  339.  
  340.     if ( sys ) {
  341.         frame = makeargs( sfun->par, f.l );
  342.         push_args( frame );
  343.         if ( (res = sfun->fun()) != 0 ) {
  344.                 char buf[ 256 ];
  345.                 snprintf( buf, sizeof(buf), 
  346.                                 "fatal error %d in %s", res, atom_name( sfun->name ));
  347.                 fatal( buf );
  348.         }
  349.     }
  350.     else {
  351.         sf = findsrc( file );
  352.         if ( !sf ) return -4;
  353.  
  354.         cur = line + 1;
  355.         maxndx = sf->lt ? lt_maxindex( sf->lt ): -1;
  356.         fun = lt_get( sf->lt, line );
  357.  
  358.         if ( !(fun && fun->type == CMD_FUNCTION) ) {
  359.             fatal( "internal function call error" );
  360.             return A_reg;
  361.         }
  362.  
  363.         frame = makeargs( fun->cmd.cmd_function.par, f.l );
  364.         push_args( frame );
  365.         
  366.         while( cur>=0 && cur<=maxndx ) {
  367.             struct command *c;
  368.             c = lt_get( sf->lt, cur );
  369.             cur = run_cmd( cur, c, sf );
  370.         }
  371.     }
  372.     
  373.     pop_args( frame );
  374.  
  375.     return A_reg;     
  376. }
  377.  
  378. /* refvar flags:  0 - all variables, 1 - defined local arguments only */
  379. int refvar( int name, unsigned flags ) 
  380. {
  381.     int  top;
  382.     
  383.     top = is_top( Stack );
  384.     if ( top )
  385.         if ( ob_defined( top, name ))
  386.             return refer( ob_field( top, name ));
  387.     
  388.     return (flags & 1) ? -1 : refer( ob_field( Globals, name ) );
  389. }
  390.  
  391. static int find_objhead( struct object_part *p )
  392. {
  393.     int base, selector, a, b;
  394.     
  395.     if ( !p ) return -1;
  396.     
  397.     switch( p->type ) {
  398.         case 'n':
  399.             return refvar( p->val.name, 0 );
  400.         case 'f':
  401.             return call( p->val.f );
  402.         case 't':
  403.             base = find_objhead( p->val.t.h );
  404.             a = tmp_alloc();
  405.             selector = eval( a, p->val.t.e );
  406.             selector = objtoint( selector );
  407.             b = refer( ob_item( base, selector ) );
  408.             tmp_free( a );
  409.             return b;
  410.     }
  411.     
  412.     return -1;
  413. }
  414.  
  415. int deref( struct object *o ) 
  416. {
  417.     int base, selector, a;
  418.     int res = -1;
  419.     const char *name;
  420.     struct object_part *p;
  421.     
  422.     if ( !o ) return -1;
  423.     if ( o->h ) 
  424.         base = deref( o->h );
  425.     else {
  426.         res = find_objhead( o->t );
  427.         return res;
  428.     }
  429.     
  430.     if ( !o->t ) {
  431.         res = -1;
  432.         return res;
  433.     }
  434.     
  435.     base = refer( base );
  436.  
  437.     switch( o->t->type ) {
  438.         case 'e':
  439.             name = evalstr( o->t->val.e.e );
  440.             res = ob_field( base, atom(name) );
  441.             break;
  442.         case 'n':
  443.             res = ob_field( base, o->t->val.name );
  444.             break;
  445.         case 'f':
  446.             return -1; 
  447.         case 't':
  448.             p = o->t;
  449.             base = find_objhead( p->val.t.h );
  450.             a = tmp_alloc();
  451.             selector = eval( a, p->val.t.e );
  452.             selector = objtoint( selector );
  453.             res = ob_item( base, selector );
  454.             tmp_free( a );
  455.             break;
  456.     }
  457.     
  458.     return refer( res );
  459. }
  460.  
  461. int makearray( int reg, struct explist *l )
  462. {
  463.     int count = l->h ? makearray( reg, l->h ): 0;
  464.     eval( ob_item( reg, count ), l->t );
  465.     return count+1;        
  466. }
  467.  
  468. void makerecord( int reg, struct fldlist *l )
  469. {
  470.     if ( !l ) return;
  471.     eval( ob_field( reg, l->name ), l->e );
  472.     makerecord( reg, l->h );
  473. }
  474.  
  475. int select_obj( struct expression *e )
  476. {
  477.     int res;
  478.     if ( !e ) return -1;
  479.    
  480.     switch ( e->type ) {
  481.         case 'a':
  482.             res = ob_item(Const, e->val.a.reg);
  483.             ob_set( res, 'i', 0 );
  484.             makearray( res, e->val.a.l );
  485.             break;
  486.         case 'r':
  487.             res = ob_item(Const, e->val.a.reg);
  488.             ob_set( res, 'i', 0 );
  489.             makerecord( res, e->val.r.l );
  490.             break;
  491.         case 'o':
  492.             res = deref( e->val.o );
  493.             break;
  494.         default:
  495.             res = -1;
  496.     }
  497.    
  498.     return res;
  499. }
  500.  
  501. void set_objval( int reg, int a, int b )
  502. {
  503.     int i;
  504.     double f;
  505.     char *s;
  506.    
  507.     a = refer( a );
  508.     b = refer( b );
  509.  
  510.     if ( b && b==a ) a = 0;
  511.     else if ( reg && reg==b ) reg = 0;
  512.     else 
  513.         switch( ob_type( b ) ) {
  514.             case 'i':
  515.                 i = ob_geti( b );
  516.                 if ( a > 0 ) ob_set( a, 'i', i );
  517.                 if ( reg > 0 ) ob_set( reg, 'i', i );
  518.                 break;
  519.             case 'f':
  520.                 f = ob_getf( b );
  521.                 if ( a > 0 ) ob_set( a, 'f', f );
  522.                 if ( reg > 0 ) ob_set( reg, 'f', f );
  523.                 break;
  524.             case 's':
  525.                 s = ob_gets( b );
  526.                 if ( a > 0 ) ob_set( a, 's', s );
  527.                 if ( reg > 0 ) ob_set( reg, 's', s );
  528.                 break;
  529.             default:
  530.                 if ( a > 0 )     ob_set( a, 'R', b );
  531.                 if ( reg > 0 )   ob_set( reg, 'R', b );
  532.         }
  533. }
  534.  
  535. static void objcmp( int reg, int a, char op, int b )
  536. {
  537.     int atype, btype;
  538.     int floatmode;
  539.     
  540.     int cmp, x, y;
  541.     float fx, fy;
  542.     
  543.     a = refer( a );
  544.     b = refer( b );
  545.     
  546.     atype = ob_type( a );
  547.     btype = ob_type( b );
  548.     
  549.     if ( atype=='s' && btype =='s' ) {
  550.         struct strbuf *sa, *sb;
  551.         sa = new_strbuf( 256, 256 );
  552.         sb = new_strbuf( 256, 256 );
  553.         sb_cat( sa, ob_gets(a), 0x7ffffff0 );
  554.         sb_cat( sb, ob_gets(b), 0x7ffffff0 );
  555.         cmp = strcmp( sb_data(sa), sb_data(sb) );
  556.         free_strbuf(sa);
  557.         free_strbuf(sb);
  558.     }
  559.     else {
  560.         floatmode = (atype=='f' || btype=='f');
  561.  
  562.         if ( floatmode ) {
  563.             switch( atype ) {
  564.                 case 'i':
  565.                     fx = ob_geti( a );
  566.                     break;
  567.                 case 'f':
  568.                     fx = ob_getf( a );
  569.                     break;
  570.                 case 's':
  571.                     fx = atof( ob_gets( a ) );
  572.                     break;
  573.                 case 'a':
  574.                 case 'r':
  575.                     fx = ob_count( a );
  576.                     break;
  577.             }
  578.             switch( btype ) {
  579.                 case 'i':
  580.                     fy = ob_geti( b );
  581.                     break;
  582.                 case 'f':
  583.                     fy = ob_getf( b );
  584.                     break;
  585.                 case 's':
  586.                     fy = atof( ob_gets( b ) );
  587.                     break;
  588.                 case 'a':
  589.                 case 'r':
  590.                     fy = ob_count( b );
  591.                     break;
  592.             }
  593.             cmp = (fx>fy) ? 1: ( (fx<fy) ? -1: 0 );
  594.         }
  595.         else {
  596.             switch( atype ) {
  597.                 case 'i':
  598.                     x = ob_geti( a );
  599.                     break;
  600.                 case 's':
  601.                     x = atoi( ob_gets( a ) );
  602.                     break;
  603.                 case 'a':
  604.                 case 'r':
  605.                     x = ob_count( a );
  606.                     break;
  607.             }
  608.             switch( btype ) {
  609.                 case 'i':
  610.                     y = ob_geti( b );
  611.                     break;
  612.                 case 's':
  613.                     y = atoi( ob_gets( b ) );
  614.                     break;
  615.                 case 'a':
  616.                 case 'r':
  617.                     y = ob_count( b );
  618.                     break;
  619.             }
  620.             cmp = (x>y) ? 1: ( (x<y) ? -1: 0 );
  621.  
  622.         }
  623.     }
  624.     
  625.     switch( op ) {
  626.         case 'e':
  627.             ob_set( reg, 'i', (cmp==0) );
  628.             break;
  629.         case '<':
  630.             ob_set( reg, 'i', (cmp<0) );
  631.             break;
  632.         case '>':
  633.             ob_set( reg, 'i', (cmp>0) );
  634.             break;
  635.         case '!':
  636.             ob_set( reg, 'i', (cmp!=0) );
  637.             break;
  638.         case 'l':
  639.             ob_set( reg, 'i', (cmp<=0) );
  640.             break;
  641.         case 'g':
  642.             ob_set( reg, 'i', (cmp>=0) );
  643.             break;
  644.     }
  645. }
  646.  
  647. void objinc( int obj, int inc )
  648. {
  649.     switch( ob_type( obj ) ) {
  650.         case 'i':
  651.             ob_set( obj, 'i', ob_geti(obj)+inc );
  652.             break;
  653.         case 'f':
  654.             ob_set( obj, 'f', ob_getf(obj)+inc );
  655.             break;
  656.     }
  657. }
  658.  
  659. void eval_exp( int reg, struct expression *a, char op, struct expression *b )
  660. {
  661.     int A, B, obj;
  662.     
  663.     switch( op ) {
  664.         case '+':
  665.         case '-':
  666.         case '*':
  667.         case '/':
  668.             A = tmp_alloc();
  669.             B = tmp_alloc();
  670.             eval( A, a );
  671.             eval( B, b );
  672.             eval_arith( reg, A, op, B );
  673.             tmp_free( A );
  674.             tmp_free( B );
  675.             break; 
  676.         case '=':
  677.             obj = select_obj( a );
  678.             B = tmp_alloc();
  679.             B = eval( B, b );
  680.             set_objval( reg, obj, B );
  681.             tmp_free( B );
  682.             break;
  683.         case '1':
  684.         case '2':
  685.         case '3':
  686.         case '4':
  687.             A = tmp_alloc();
  688.             B = tmp_alloc();
  689.             obj = select_obj( a );
  690.             A = eval( A, a );
  691.             B = eval( B, b );
  692.             eval_arith( reg, A, "*/+-"[op-'1'], B );
  693.             set_objval( 0, obj, reg );
  694.             tmp_free( A );
  695.             tmp_free( B );
  696.             break;
  697.         case 'e':
  698.         case '<':
  699.         case '>':
  700.         case '!':
  701.         case 'l':
  702.         case 'g':
  703.             A = tmp_alloc();
  704.             B = tmp_alloc();
  705.             eval( A, a );
  706.             eval( B, b );
  707.             objcmp( reg, A, op, B );
  708.             tmp_free( A );
  709.             tmp_free( B );
  710.             break;
  711.         case '|':
  712.         case '&':
  713.             A = tmp_alloc();
  714.             B = tmp_alloc();
  715.             eval( A, a );
  716.             eval( B, b );
  717.             ob_set( reg, 'i', 
  718.                    (op=='|') ? (istrue(A)||istrue(B)) :
  719.                                (istrue(A)&&istrue(B))); 
  720.             tmp_free( A );
  721.             tmp_free( B );
  722.             break;
  723.         case 'i':
  724.             A = select_obj( a );
  725.             set_objval( reg, 0, A );
  726.             objinc( A, +1 );
  727.             break;
  728.         case 'd':
  729.             A = select_obj( a );
  730.             set_objval( reg, 0, A );
  731.             objinc( A, -1 );
  732.             break;
  733.         case 'I':
  734.             A = select_obj( a );
  735.             objinc( A, +1 );
  736.             set_objval( reg, 0, A );
  737.             break;
  738.         case 'D':
  739.             A = select_obj( a );
  740.             objinc( A, -1 );
  741.             set_objval( reg, 0, A );
  742.             break;
  743.         case 'n':
  744.             B = tmp_alloc();
  745.             eval( B, b );
  746.             A = istrue( B );
  747.             ob_set( B, 'i', !A );
  748.             set_objval( reg, 0, B );
  749.             tmp_free( B );
  750.             break;
  751.             
  752.     }
  753. }
  754.  
  755. int eval( int reg, struct expression *e )
  756. {
  757. #if  DEBUG
  758.     char dbuf[ 2048 ];
  759. #endif    
  760.     int obj;
  761.     
  762.     if ( !eval_initialized ) init_eval();
  763.     if ( !e ) return -1;
  764.     
  765.     if ( reg <= 0 ) reg = A_reg;
  766.  
  767. #if  DEBUG
  768.     dump_expression( dbuf, sizeof(dbuf), e );
  769.     dbpr( "eval( %d, %s )\n", reg, dbuf );
  770. #endif    
  771.     
  772.     switch( e->type ) {
  773.         case 'a':
  774.         case 'r':
  775.             obj = select_obj( e );
  776.             set_objval( reg, 0, obj );
  777.             return reg;
  778.         case 'i':
  779.             ob_set( reg, 'i', e->val.i );
  780.             return reg;
  781.         case 'f':
  782.             ob_set( reg, 'f', e->val.f );
  783.             return reg;
  784.         case 's':
  785.             ob_set( reg, 's', e->val.s );
  786.             return reg;
  787.         case 'o':
  788.             obj = select_obj( e );
  789.             if ( obj<0 ) 
  790.                 warning( "warning: uninitialized object" );
  791.  
  792.             set_objval( reg, 0, obj );
  793.             dbpr( "eval result: %d=%s\n", reg, print_obj(reg) );
  794.             return reg;
  795.             break;
  796.         case '+':
  797.             eval_exp( reg, e->val.oper.a, e->val.oper.op, 
  798.                     e->val.oper.b );
  799.             return reg;
  800.     }
  801.  
  802.     return -1;
  803. }
  804.  
  805. const char *evalstr( struct expression *e )
  806. {
  807.     int res;
  808.  
  809.     res = eval( 0, e ); 
  810.     return print_obj( res );
  811. }
  812.  
  813. int istrue( int obj )
  814. {
  815.     int type;
  816.    
  817.     obj = refer( obj );
  818.     type = ob_type( obj );
  819.     switch( type ) {
  820.         case 'i':
  821.             return ob_geti( obj ) != 0;
  822.         case 'f':
  823.             return ob_getf( obj ) != 0.0;
  824.         default:
  825.             return 0;
  826.     }
  827. }
  828.  
  829. void setret( struct expression *e )
  830. {
  831.     eval( A_reg, e );
  832. }
  833.  
  834. void setrets( const char *s )
  835. {
  836.     ob_set( A_reg, 's', s );
  837. }
  838.  
  839. void setreti( int i )
  840. {
  841.     ob_set( A_reg, 'i', i );
  842. }
  843.  
  844. void setretf( double x )
  845. {
  846.     ob_set( A_reg, 'f', x );
  847. }
  848.  
  849. void setreti( int );
  850.  
  851. static int makearglis( int frame, struct explist *l )
  852. {
  853.     int n;
  854.     if ( !l ) return 0;
  855.     
  856.     if ( l->h ) {
  857.         int res;
  858.         res = makearglis( frame, l->h );
  859.         if ( res ) return res;
  860.     }
  861.  
  862.     if ( !l->t ) return -1;      /* explist malformed */
  863.     n = ob_count( frame );
  864.     set_objval( 0, ob_item( frame, n ), eval( 0, l->t ));
  865.     return 0;
  866. }
  867.  
  868. int find_case( int obj, struct caselist *cl )
  869. {
  870. #if DEBUG    
  871.     char dbuf[ 128 ];
  872. #endif    
  873.     int A, B, eq;
  874.     
  875.     if ( !( cl && cl->e ) ) return -1;
  876.     A = tmp_alloc();
  877.     B = tmp_alloc();
  878. #if DEBUG    
  879.     dump_expression( dbuf, sizeof(dbuf), cl->e );
  880.     dbpr( "find_case, exp: %s\n", dbuf );
  881. #endif    
  882.     eval( A, cl->e );
  883.     dbpr( "find_case, compare: %d==%d %s==%s\n", obj, A, print_obj(obj), print_obj(A));
  884.     objcmp( B, A, 'e', obj );
  885.     eq = istrue( B );
  886.     tmp_free( A );
  887.     tmp_free( B );
  888.     if ( eq ) return cl->line;
  889.     return find_case( obj, cl->h );
  890. }
  891.  
  892. void create_local( int name )
  893. {
  894.     int top;
  895.     
  896.     top = is_top( Stack );
  897.     if ( top ) ob_field( top, name );
  898. }
  899.